home *** CD-ROM | disk | FTP | other *** search
/ The Arsenal Files 8 / The Arsenal Files Collection #8 (Arsenal Computer) (1996).ISO / prg_gen / euphor14.zip / DISPLAY.E < prev    next >
Text File  |  1995-04-16  |  11KB  |  445 lines
  1. -- display.e
  2. -- graphics, sound and text display on screen
  3.  
  4. global sequence ship
  5.  
  6. global sequence ds -- Euphoria deflectors
  7. global sequence ts -- Euphoria torpedos
  8. global sequence ps -- Euphoria anti-matter pods 
  9.  
  10. global function c_remaining()
  11. -- number of C ships (of all types) left
  12.     return nobj[G_KRC] + nobj[G_ANC] + nobj[G_CPP]
  13. end function
  14.  
  15. type negative_atom(atom x)
  16.     return x <= 0
  17. end type
  18.  
  19. global procedure p_energy(negative_atom delta)
  20. -- print Euphoria energy
  21.     atom energy
  22.  
  23.     energy = quadrant[EUPHORIA][Q_EN] + delta
  24.     quadrant[EUPHORIA][Q_EN] = energy
  25.     if energy < 0 then
  26.     energy = 0
  27.     gameover = TRUE
  28.     end if
  29.     position(WARP_LINE, ENERGY_POS+7)
  30.     set_bk_color(WHITE)
  31.     if energy < 5000 then
  32.     set_color(RED+BLINKING)
  33.     else
  34.     set_color(BLACK)
  35.     end if
  36.     printf(CRT, "%d    ", floor(energy))
  37. end procedure
  38.  
  39. global procedure task_life()
  40. -- independent task: life support energy 
  41.     if shuttle then
  42.     p_energy(-3)
  43.     else
  44.     p_energy(-17)
  45.     end if
  46. end procedure
  47.  
  48. ------------------------- message handler -----------------------------
  49. -- All messages come here. A task ensures that messages will be displayed
  50. -- on the screen for at least a second or so, before being overwritten by
  51. -- the next message. If there is no queue, a message will be printed 
  52. -- immediately, otherwise it is added to the queue. 
  53.  
  54. constant MESSAGE_GAP = 1.2  -- seconds between messages for readability
  55.  
  56. sequence message_queue
  57. message_queue = {}
  58.  
  59. global procedure set_msg()
  60. -- prepare to print a message
  61.     set_bk_color(WHITE)
  62.     set_color(RED)
  63.     position(MSG_LINE, MSG_POS)
  64.     puts(CRT, BLANK_LINE[1..50])
  65.     position(MSG_LINE, MSG_POS)
  66. end procedure
  67.  
  68. global procedure msg(sequence text)
  69. -- print a plain text message on the message line
  70.     if length(message_queue) = 0 then
  71.     -- print it right away
  72.     set_msg()
  73.     puts(CRT, text)
  74.     sched(TASK_MESSAGE, MESSAGE_GAP)        
  75.     end if
  76.     message_queue = append(message_queue, text)
  77. end procedure
  78.  
  79. global procedure fmsg(sequence format, object values)
  80. -- print a formatted message on the message line
  81.     msg(sprintf(format, values))
  82. end procedure
  83.  
  84. global procedure task_message()
  85. -- task to display next message in message queue
  86.  
  87.     -- first message is already on the screen - delete it
  88.     message_queue = message_queue[2..length(message_queue)]
  89.     if length(message_queue) = 0 then
  90.     wait[TASK_MESSAGE] = INACTIVE   -- deactivate this task
  91.     else
  92.     set_msg()
  93.     puts(CRT, message_queue[1])
  94.     wait[TASK_MESSAGE] = MESSAGE_GAP
  95.     end if
  96. end procedure
  97.  
  98. ----------------------------------------------------------------------------
  99.  
  100. global procedure show_warp()
  101. -- show current speed (with warning)
  102.     set_bk_color(WHITE)
  103.     set_color(BLACK)
  104.     position(WARP_LINE, WARP_POS)
  105.     puts(CRT, "WARP:")
  106.     if curwarp > wlimit then
  107.     set_color(RED+BLINKING)
  108.     end if
  109.     printf(CRT, "%d", curwarp)
  110. end procedure
  111.  
  112. -- how long it takes Euphoria to move at warp 0 thru 5:
  113. constant warp_time = {0, 20, 4.5, 1.5, .7, .25}
  114.  
  115. global procedure setwarp(warp new)
  116. -- establish a new warp speed for the Euphoria
  117.  
  118.     if new != curwarp then
  119.     wait[TASK_EMOVE] = warp_time[new+1]
  120.     eat[TASK_EMOVE] = (5-new)/20 + 0.05
  121.     sched(TASK_EMOVE, wait[TASK_EMOVE])
  122.     curwarp = new
  123.     show_warp()
  124.     end if
  125. end procedure
  126.  
  127. global procedure gtext()
  128. -- print text portion of galaxy scan
  129.     set_bk_color(BLUE)
  130.     position(2, 37)
  131.     set_color(BRIGHT_RED)
  132.     puts(CRT, "C ")
  133.     set_color(BROWN)
  134.     puts(CRT, "P ")
  135.     set_color(YELLOW)
  136.     puts(CRT, "B")
  137.     set_color(WHITE)
  138.     position(3, 15)
  139.     puts(CRT, "1       2       3       4       5       6       7")
  140.     for i = 1 to 7 do
  141.     position(2*i + 2, 10)
  142.     printf(CRT, "%d.", i)
  143.     end for
  144.     position(18, 37)
  145.     set_color(BRIGHT_WHITE)
  146.     printf(CRT, "C: %d ", c_remaining())
  147.     position(19, 24)
  148.     set_color(WHITE)
  149.     printf(CRT, "Planets: %d   BASIC: %d", {nobj[G_PL], nobj[G_BAS]})
  150.     if bstat = TRUCE then
  151.     puts(CRT, " TRUCE   ")
  152.     elsif bstat = HOSTILE then
  153.     puts(CRT, " HOSTILE ")
  154.     else
  155.     set_color(WHITE+BLINKING)
  156.     puts(CRT, " CLOAKING")
  157.     set_color(WHITE)
  158.     end if
  159.     position(20, 24)
  160.     printf(CRT, "Bases: %d     Fortran: %d ", {nobj[G_BS], nobj[G_FOR]})
  161.     position(20, 67)
  162.     set_color(BLUE)
  163.     set_bk_color(WHITE)
  164.     if level = 'n' then
  165.     puts(CRT, "NOVICE LEVEL")
  166.     else
  167.     puts(CRT, "EXPERT LEVEL")
  168.     end if
  169. end procedure
  170.  
  171. function source_of_energy(g_index qrow, g_index qcol, object_type t)
  172. -- see if there is any energy left from planets / bases in this quadrant
  173.     pb_row start, stop
  174.  
  175.     if t = G_BS then
  176.     start = 1
  177.     stop = NBASES
  178.     else
  179.     start = NBASES + 1
  180.     stop = length(pb)
  181.     end if
  182.     for pbi = start to stop do
  183.     if pb[pbi][P_TYPE] != DEAD then
  184.         if pb[pbi][P_QR] = qrow then
  185.         if pb[pbi][P_QC] = qcol then
  186.             if pb[pbi][P_EN] > 0 then
  187.             return TRUE
  188.             end if
  189.         end if
  190.         end if
  191.     end if
  192.     end for
  193.     return FALSE
  194. end function
  195.  
  196. function g_screen_pos(g_index qrow, g_index qcol)
  197. -- compute position on screen to display a galaxy scan quadrant
  198.     return {5 + qcol * 8, qrow * 2 + 2}
  199. end function
  200.  
  201. global procedure gquad(g_index qrow, g_index qcol)
  202. -- print one galaxy scan quadrant
  203.  
  204.     natural nk, np, nb
  205.     sequence quad_info
  206.     screen_pos gpos
  207.  
  208.     gpos = g_screen_pos(qrow, qcol)
  209.     position(gpos[2], gpos[1])
  210.     quad_info = galaxy[qrow][qcol]
  211.     if quad_info[1] then
  212.     nk = quad_info[G_KRC] + quad_info[G_ANC] + quad_info[G_CPP]
  213.     set_color(BRIGHT_RED)
  214.     printf(CRT, "%d ", nk)
  215.  
  216.     np = quad_info[G_PL]
  217.     if np = 0 then
  218.         set_color(BROWN)
  219.     elsif source_of_energy(qrow, qcol, G_PL) then
  220.         set_color(BROWN)
  221.     else
  222.         set_color(GRAY)
  223.     end if
  224.     printf(CRT, "%d ", np)
  225.  
  226.     nb = quad_info[G_BS]
  227.     if nb = 0 then
  228.         set_color(YELLOW)
  229.     elsif source_of_energy(qrow, qcol, G_BS) then
  230.         set_color(YELLOW)
  231.     else
  232.         set_color(GRAY)
  233.     end if
  234.     printf(CRT, "%d",  nb)
  235.  
  236.     set_color(WHITE)
  237.     else
  238.     puts(CRT, "*****")
  239.     end if
  240. end procedure
  241.  
  242. global procedure upg(g_index qrow, g_index qcol)
  243. -- update galaxy scan quadrant
  244.     if scanon then
  245.     set_bk_color(BLUE)
  246.     set_color(WHITE)
  247.     gquad(qrow, qcol)
  248.     end if
  249. end procedure
  250.  
  251. sequence prev_box
  252. prev_box = {}
  253.  
  254. global procedure gsbox(g_index qrow, g_index qcol)
  255. -- indicate current quadrant on galaxy scan
  256.     screen_pos gpos
  257.  
  258.     if scanon then
  259.     set_bk_color(BLUE)
  260.     if length(prev_box) = 2 then
  261.         -- clear the previous "box" (could be gone already)
  262.         position(prev_box[2], prev_box[1]-1)
  263.         puts(CRT, ' ')
  264.         position(prev_box[2], prev_box[1]+5)
  265.         puts(CRT, ' ')
  266.     end if
  267.     set_color(WHITE)
  268.     gquad(qrow, qcol)
  269.     gpos = g_screen_pos(qrow, qcol)
  270.     position(gpos[2], gpos[1]-1)
  271.     set_color(BRIGHT_WHITE)
  272.     puts(CRT, '[')
  273.     position(gpos[2], gpos[1]+5)
  274.     puts(CRT, ']')
  275.     prev_box = gpos
  276.     end if
  277. end procedure
  278.  
  279. constant dir_places = {{1, 6},{0, 6},{0, 3},{0, 0},{1, 0},{2, 0},{2, 3},{2, 6}}
  280.  
  281. global procedure dir_box()
  282.     -- direction box
  283.     sequence place
  284.  
  285.     set_bk_color(RED)
  286.     set_color(BLACK)
  287.     position(WARP_LINE, DIRECTIONS_POS)
  288.     puts(CRT, "4  3  2")
  289.     position(CMD_LINE, DIRECTIONS_POS)
  290.     puts(CRT, "5  +  1")
  291.     position(MSG_LINE, DIRECTIONS_POS)
  292.     puts(CRT, "6  7  8")
  293.     place = dir_places[curdir]
  294.     position(place[1]+WARP_LINE,place[2]+DIRECTIONS_POS) 
  295.     set_bk_color(GREEN)
  296.     printf(CRT, "%d", curdir)
  297.     set_bk_color(WHITE)
  298. end procedure
  299.  
  300. global procedure wtext()
  301. -- print torpedos, pods, deflectors in text window
  302.     set_bk_color(WHITE)
  303.     set_color(BLACK)
  304.     position(WARP_LINE, WEAPONS_POS)
  305.     printf(CRT, "%s %s %s ", {ts, ds, ps}) 
  306. end procedure
  307.  
  308. global procedure stext()
  309. -- print text window info
  310.     position(QUAD_LINE, 1)
  311.     set_bk_color(CYAN)
  312.     set_color(MAGENTA)
  313.     printf(CRT,
  314.     "--------------------------------- QUADRANT %d.%d ---------------------------------"
  315.        ,{qrow, qcol})
  316.     set_bk_color(WHITE)
  317.     set_color(BLACK)
  318.     show_warp()
  319.     wtext()
  320.     position(WARP_LINE, ENERGY_POS)
  321.     printf(CRT, "ENERGY:%d    ", floor(quadrant[EUPHORIA][Q_EN]))
  322.     position(CMD_LINE, CMD_POS-30)
  323.     puts(CRT, "COMMAND(1-8 w p t a g $ ! x): ")
  324.     dir_box()
  325. end procedure
  326.  
  327. procedure p_source(valid_quadrant_row row)
  328. -- print a base or planet
  329.     h_coord x
  330.     v_coord y
  331.  
  332.     x = quadrant[row][Q_X]
  333.     y = quadrant[row][Q_Y]
  334.     if quadrant[row][Q_TYPE] = G_PL then
  335.     write_screen(x, y, PLANET_TOP)
  336.     write_screen(x, y+1, PLANET_MIDDLE)
  337.     write_screen(x, y+2, PLANET_BOTTOM)
  338.     else
  339.     write_screen(x, y, BASE)
  340.     write_screen(x, y+1, BASE)
  341.     end if
  342. end procedure
  343.  
  344. procedure p_ship(valid_quadrant_row row)
  345. -- reprint a ship to get color
  346.     h_coord x
  347.     v_coord y
  348.     object_type t
  349.     sequence shape
  350.  
  351.     x = quadrant[row][Q_X]
  352.     y = quadrant[row][Q_Y]
  353.     t = quadrant[row][Q_TYPE]
  354.     shape = read_screen({x, length(ship[t][1])},  y)
  355.     write_screen(x, y, shape)
  356. end procedure
  357.  
  358. procedure refresh_obj()
  359. -- reprint objects after a galaxy scan
  360.     for i = 1 to length(quadrant) do
  361.     if quadrant[i][Q_TYPE] = G_BS or quadrant[i][Q_TYPE] = G_PL then
  362.         p_source(i)
  363.     elsif quadrant[i][Q_TYPE] != DEAD then
  364.         p_ship(i)
  365.     end if
  366.     end for
  367. end procedure
  368.  
  369. global procedure setg1()
  370. -- end display of galaxy scan
  371.     if scanon then
  372.     scanon = FALSE
  373.     ShowScreen()
  374.     refresh_obj()
  375.     end if
  376. end procedure
  377.  
  378.  
  379. global procedure pobj()
  380. -- print objects in a new quadrant
  381.     h_coord x
  382.     v_coord y
  383.     sequence c
  384.     natural len
  385.     object_type t
  386.     sequence taken
  387.  
  388.     set_bk_color(BLACK)
  389.     set_color(WHITE)
  390.     BlankScreen(TRUE)
  391.  
  392.     -- print stars
  393.     for i = 1 to 15 do
  394.     write_screen(rand(HSIZE), rand(VSIZE), STAR)
  395.     end for
  396.  
  397.     -- print planets and bases
  398.     taken = {}
  399.     for row = 2 to length(quadrant) do
  400.     if find(quadrant[row][Q_TYPE], {G_PL, G_BS}) then
  401.         -- look it up in pb sequence
  402.         for pbi = 1 to length(pb) do
  403.         if pb[pbi][P_TYPE] = quadrant[row][Q_TYPE] then
  404.             if pb[pbi][P_QR] = qrow and pb[pbi][P_QC] = qcol then
  405.             if not find(pbi, taken) then
  406.                 quadrant[row][Q_X] = pb[pbi][P_X]
  407.                 quadrant[row][Q_Y] = pb[pbi][P_Y]
  408.                 quadrant[row][Q_PBX] = pbi
  409.                 taken = taken & pbi
  410.                 exit
  411.             end if
  412.             end if
  413.         end if
  414.         end for
  415.         p_source(row)
  416.     end if
  417.     end for
  418.  
  419.     -- print ships
  420.     for row = 2 to length(quadrant) do
  421.     if not find(quadrant[row][Q_TYPE], {G_PL, G_BS})  then
  422.         len = length(ship[quadrant[row][Q_TYPE]][1])
  423.         while TRUE do
  424.         -- look for an empty place to put the ship
  425.         x = rand(HSIZE - len - 5) + 3 -- allow space for Euphoria to enter
  426.         y = rand(VSIZE - 2) + 1
  427.         c = read_screen({x, len}, y)
  428.         if not find(FALSE, c = ' ' or c = STAR) then
  429.             exit
  430.         end if
  431.         end while
  432.         quadrant[row][Q_UNDER] = c
  433.         quadrant[row][Q_X] = x
  434.         quadrant[row][Q_Y] = y
  435.         t = quadrant[row][Q_TYPE]
  436.         if x < quadrant[EUPHORIA][Q_X] then
  437.         c = ship[t][2]
  438.         else
  439.         c = ship[t][1]
  440.         end if
  441.         write_screen(x, y, c)
  442.     end if
  443.     end for
  444. end procedure
  445.